home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 08 - 1992 / 08.03 Jul 92 / Matrix Parser / LexicalAnalysis < prev    next >
Encoding:
Text File  |  1992-12-24  |  6.9 KB  |  217 lines  |  [TEXT/PJMM]

  1. unit LexicalAnalysis;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Globals;
  7.  
  8.  
  9.     procedure lexicalanalysis (var line: str255; var removeblanks: boolean; var ntot: longint; var sy, tokentype: hdlstringarray0; var pr: hdlintarray0; var error: str255);
  10.  
  11.  
  12. implementation
  13.  
  14.  
  15.     procedure lexicalanalysis;
  16.  
  17.         label
  18.             99, 999, 9999;
  19.  
  20.         var
  21.             i, j, k, place, len, numstrings, mtot: longint;
  22.             s1, s2, s3, s4, s5: boolean;
  23.             ind, nst, nend: hdlintarray0;
  24.             astr: hdlstringarray0;
  25.             ch, ch1, ch2, ch3: char;
  26.             ty: hdlstringarray0;
  27.             x: extended;
  28.             flag: hdlflagtype;
  29.  
  30.  
  31.     begin
  32.  
  33.         ind := hdlintarray0(NewHandle(SizeOf(intarray0)));
  34.         nst := hdlintarray0(NewHandle(SizeOf(intarray0)));
  35.         nend := hdlintarray0(NewHandle(SizeOf(intarray0)));
  36.         astr := hdlstringarray0(NewHandle(SizeOf(stringarray0)));
  37.  
  38.         place := pos(semicolon, line);
  39.  
  40.         if place = 0 then                      {Putting a semicolon at the end of the statement,line, for a}
  41.             line := concat(line, ';');           {delimiter, if it isn't already there.}
  42.  
  43.         removeblanks := false;
  44.  
  45.         if removeblanks then
  46.             begin
  47.                 place := pos(blank, line);
  48.                 while place <> 0 do
  49.                     begin
  50.                         delete(line, place, 1);
  51.                         place := pos(blank, line);
  52.                     end;
  53.             end;
  54.  
  55.         for i := 1 to length(line) do
  56.             begin
  57.                 ind^^[i] := 0;                                        {Initialize ind^^[i] array.}
  58.                 k := ord(line[i]);
  59.                 if ((65 <= k) and (k <= 90)) or ((97 <= k) and (k <= 122)) then
  60.                     ind^^[i] := 1;     {if line[i] is a letter of alphabet, set ind^^[i] = 1}
  61.                 if ((48 <= k) and (k <= 57)) or (k = 46) then
  62.                     ind^^[i] := 2;     {if line[i] is a number or decimal, set ind^^[i] = 2}
  63.             end;
  64.  
  65.         numstrings := 0;
  66.         for i := 1 to length(line) do
  67.             begin
  68.                 if (i = 1) and ((ind^^[i] = 1) or (ind^^[i] = 2)) then
  69.                     begin
  70.                         numstrings := numstrings + 1;        {if first character is 1 or 2, string starts}
  71.                         nst^^[numstrings] := i;                 {at the first character position of line}
  72.                     end;
  73.  
  74.                 if i > 3 then
  75.                     if (ind^^[i] = 2) and ((line[i - 1] = '+') or (line[i - 1] = '-')) then
  76.                         if ((line[i - 2] = 'e') or (line[i - 2] = 'E')) and ((ind^^[i - 3] = 2)) then
  77.                             goto 999;
  78.  
  79.                 if i > 4 then
  80.                     if (ind^^[i] = 2) and (ind^^[i - 1] = 2) and ((line[i - 2] = '+') or (line[i - 2] = '-')) then
  81.                         if ((line[i - 3] = 'e') or (line[i - 3] = 'E')) and ((ind^^[i - 4] = 2)) then
  82.                             goto 999;
  83.  
  84.                 if i > 1 then
  85.                     if (ind^^[i] <> 0) and (ind^^[i - 1] = 0) then
  86.                         begin
  87.                             numstrings := numstrings + 1;      {Start of string at ith position if 1 or 2 follows}
  88.                             nst^^[numstrings] := i;               {a 0 after the first character position.}
  89.                         end;
  90.  
  91.                 if i > 1 then
  92.                     if (ind^^[i] = 0) and (ind^^[i - 1] <> 0) then              {End of string at (i-1)th position if}
  93.                         nend^^[numstrings] := i - 1;                                    {ith is a 0 and (i-1)the is <> 0. }
  94.  
  95.                 if (i = length(line)) then
  96.                     if ((ind^^[i] = 1) or (ind^^[i] = 2)) then
  97.                         nend^^[numstrings] := i;
  98.  
  99. 999:
  100.             end;
  101.  
  102.         for i := 1 to numstrings do
  103.             astr^^[i] := nil;
  104.  
  105.         for i := 1 to numstrings do
  106.             if astr^^[i] = nil then
  107.                 begin
  108.                     astr^^[i] := hdlstringsize(NewHandle(SizeOf(stringsize)));
  109.                     astr^^[i]^^ := '';                                      {Initialize astr^^[i]^^ strings to null strings.}
  110.                 end;
  111.  
  112.         for i := 1 to numstrings do
  113.             astr^^[i]^^ := copy(line, nst^^[i], nend^^[i] + 1 - nst^^[i]);
  114.  
  115.         DisposHandle(handle(ind));                              {Free up space on the heap.}
  116.  
  117.         ntot := 0;
  118.         for i := 1 to numstrings do                           {Meshing strings and operators to get}
  119.             for j := 1 to length(line) do                        {tokens, sy^^[i]^^, i = 1, ntot}
  120.                 begin
  121.                     s1 := (j < nst^^[i]) and (i = 1);
  122.                     s2 := (nend^^[i] < j) and (j < nst^^[i + 1]) and (i < numstrings);
  123.                     s3 := (nend^^[i] < j) and (i = numstrings);
  124.                     if s1 or s2 or s3 then
  125.                         begin
  126.                             ntot := ntot + 1;
  127.                             sy^^[ntot] := hdlstringsize(NewHandle(SizeOf(stringsize)));
  128.                             sy^^[ntot]^^ := line[j];
  129.                             goto 9999;
  130.                         end;
  131.                     if (nst^^[i] = j) then
  132.                         begin
  133.                             ntot := ntot + 1;
  134.                             sy^^[ntot] := hdlstringsize(NewHandle(SizeOf(stringsize)));
  135.                             sy^^[ntot]^^ := astr^^[i]^^;
  136.                             goto 9999;
  137.                         end;
  138.                     if (nst^^[i] < j) and (j <= nend^^[i]) then
  139.                         goto 9999;
  140. 9999:
  141.                 end;
  142.         sy^^[0] := hdlstringsize(NewHandle(SizeOf(stringsize)));
  143.         sy^^[0]^^ := '@';
  144.  
  145.         DisposHandle(handle(nst));
  146.         DisposHandle(handle(nend));                         {Free up space on the heap.}
  147.         DisposHandle(handle(astr));
  148.  
  149.         ty := hdlstringarray0(NewHandle(SizeOf(stringarray0)));
  150.         mtot := -1;
  151.  
  152.         for i := 0 to ntot do
  153.             if sy^^[i]^^ <> blank then
  154.                 begin
  155.                     mtot := mtot + 1;
  156.                     ty^^[mtot] := hdlstringsize(NewHandle(SizeOf(stringsize)));
  157.                     ty^^[mtot]^^ := sy^^[i]^^;
  158.                 end;
  159.         ntot := mtot;
  160.         for i := 1 to ntot do
  161.             sy^^[i]^^ := ty^^[i]^^;
  162.  
  163.         DisposHandle(handle(ty));
  164.  
  165.         for i := 0 to ntot do  {setting token types, tokentype^^[i]^^, i = 1, ntot}
  166.             begin
  167.                 tokentype^^[i] := hdlstringsize(NewHandle(SizeOf(stringsize)));
  168.                 tokentype^^[i]^^ := 'string';
  169.                 if (sy^^[i]^^ = exponent) or (sy^^[i]^^ = asterisk) or (sy^^[i]^^ = crosshatch) or (sy^^[i]^^ = leftslash) or (sy^^[i]^^ = rightslash) or (sy^^[i]^^ = plus) or (sy^^[i]^^ = minus) or (sy^^[i]^^ = equals) or (sy^^[i]^^ = rightparen) or (sy^^[i]^^ = semicolon) or (sy^^[i]^^ = leftparen) or (sy^^[i]^^ = ampersand) then
  170.                     tokentype^^[i]^^ := 'binary';
  171.                 if (sy^^[i]^^ = 'pi') or (tokentype^^[i]^^ = 'string') and (((48 <= ord(sy^^[i]^^[1])) and (ord(sy^^[i]^^[1]) <= 57)) or (ord(sy^^[i]^^[1]) = 46)) then
  172.                     tokentype^^[i]^^ := 'constant';
  173.                 if (sy^^[i]^^ = '''') or (sy^^[i]^^ = 'abs') or (sy^^[i]^^ = 'inv') or (sy^^[i]^^ = 'sqrt') or (sy^^[i]^^ = 'sin') or (sy^^[i]^^ = 'exp') or (sy^^[i]^^ = 'ln') then
  174.                     tokentype^^[i]^^ := 'function';
  175.                 if (tokentype^^[i]^^ = 'string') and (tokentype^^[i]^^ <> 'binary') and (tokentype^^[i]^^ <> 'constant') and (tokentype^^[i]^^ <> 'function') then
  176.                     tokentype^^[i]^^ := 'variable';
  177.                 if i > 0 then
  178.                     begin
  179.                         s1 := ((sy^^[i]^^ = plus) or (sy^^[i]^^ = minus));
  180.                         s2 := (tokentype^^[i - 1]^^ <> 'variable') and (tokentype^^[i - 1]^^ <> 'constant');
  181.                         s3 := (sy^^[i - 1]^^ <> rightparen) and (sy^^[i - 1]^^ <> quote);
  182.                         if (s1 and s2 and s3) then
  183.                             tokentype^^[i]^^ := 'unary';
  184.                     end;
  185.  
  186.             end;
  187.  
  188.  
  189.         for i := 0 to ntot do
  190.             begin
  191.                 if (sy^^[i]^^ = exponent) then
  192.                     pr^^[i] := 8;
  193.                 if (tokentype^^[i]^^ = 'function') then
  194.                     pr^^[i] := 7;
  195.                 if (sy^^[i]^^ = asterisk) or (sy^^[i]^^ = crosshatch) or (sy^^[i]^^ = rightslash) or (sy^^[i]^^ = leftslash) then
  196.                     pr^^[i] := 6;
  197.                 if (sy^^[i]^^ = plus) or (sy^^[i]^^ = minus) then
  198.                     pr^^[i] := 5;
  199.                 if sy^^[i]^^ = equals then
  200.                     pr^^[i] := 4;
  201.                 if (sy^^[i]^^ = rightparen) or (sy^^[i]^^ = semicolon) then
  202.                     pr^^[i] := 3;
  203.                 if sy^^[i]^^ = leftparen then
  204.                     pr^^[i] := 2;
  205.                 if sy^^[i]^^ = '@' then
  206.                     pr^^[i] := 1;
  207.                 if (tokentype^^[i]^^ <> 'function') and (tokentype^^[i]^^ <> 'binary') then
  208.                     pr^^[i] := 0;
  209.             end;
  210.  
  211. 99:
  212.  
  213.  
  214.     end;
  215.  
  216.  
  217. end.